home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / lang / PPCcforth.lha / PPCcforth / forth.line < prev    next >
Text File  |  1985-12-27  |  11KB  |  495 lines
  1. ------------------ SCREEN 0 ------------------
  2.  
  3.  
  4. ================================================================
  5. ||      C-CODED FIG-FORTH for UNIX* systems by ALLAN PRATT    ||
  6. ||                                                            ||
  7. ||      INCLUDES \ COMMENTS,                                  ||
  8. ||               CASE..OF..ENDOF..ENDCASE                     ||
  9. ||               UNTHREAD, EDITOR                             ||
  10. ||               REFORTH,                                     ||
  11. ||               "ALIAS NEW OLD"                              ||
  12. ||      AND OTHER NICE THINGS.                                ||
  13. || ( * UNIX is a trademark of Bell Labs )                     ||
  14. ================================================================
  15.  
  16.  
  17.  
  18. ------------------ SCREEN 1 ------------------
  19. ( UNTHREAD VERSION 2 / SCREEN 1 OF 3 )
  20. : DOQUOTE                       \ AFTER (.")
  21.   34 EMIT WORDSIZE + DUP C@ OVER 1+ SWAP TYPE
  22.   34 EMIT SPACE DUP C@ + 1+ ;
  23.  
  24. : DOLIT         \ AFTER LIT, BRANCHES, AND (LOOP)S
  25.   WORDSIZE + DUP @ . WORDSIZE + ;
  26.  
  27.  
  28.  
  29.  
  30. -->
  31.  
  32.  
  33.  
  34.  
  35. ------------------ SCREEN 2 ------------------
  36. ( UNTHREAD VERSION 2 / SCREEN 2 OF 3 )
  37. : DOWORD        \ MAIN UNTHREADER
  38.   DUP @ WORDSIZE + DUP NFA ID.  CASE
  39.     ' LIT       OF DOLIT        ENDOF
  40.     ' 0BRANCH   OF DOLIT        ENDOF
  41.     ' BRANCH    OF DOLIT        ENDOF
  42.     ' (LOOP)    OF DOLIT        ENDOF
  43.     ' (+LOOP)   OF DOLIT        ENDOF
  44.     ' (.")      OF DOQUOTE      ENDOF
  45.     ' ;S        OF DROP 0       ENDOF \ LEAVE 0
  46.     DUP         OF WORDSIZE +   ENDOF \ DEFAULT
  47.   ENDCASE ;
  48.  
  49. -->
  50.  
  51.  
  52. ------------------ SCREEN 3 ------------------
  53. ( UNTHREAD VERSION 2 / SCREEN 3 OF 3 )
  54. : UNTHREAD      \ USAGE: UNTHREAD WORD
  55.   [COMPILE] ' DUP CFA @
  56.   ' DOWORD CFA @ <> 27 ?ERROR   \ NOT THREADED
  57.   CR ." : " DUP NFA ID. SPACE
  58.   BEGIN
  59.     DOWORD
  60.     OUT @ C/L > IF CR THEN
  61.     -DUP WHILE
  62.   REPEAT ;
  63.  
  64. CR ." UNTHREAD READY"
  65.  
  66. ;S
  67.  
  68.  
  69. ------------------ SCREEN 4 ------------------
  70. ( ERROR MESSAGES )
  71. EMPTY STACK
  72.  
  73.  
  74. ISN'T UNIQUE
  75.  
  76.  
  77. FULL STACK
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85. C-CODED figFORTH by ALLAN PRATT / APRIL 1985
  86. ------------------ SCREEN 5 ------------------
  87. MSG # 16
  88. MUST BE COMPILING
  89. MUST BE EXECUTING
  90. UNMATCHED STRUCTURES
  91. DEFINITION NOT FINISHED
  92. WORD IS PROTECTED BY FENCE
  93. MUST BE LOADING
  94.  
  95. CONTEXT ISN'T CURRENT
  96.  
  97.  
  98. ALIAS: NOT A COLON DEFINITION
  99. ALIAS: CAN'T ALIAS A NULL WORD
  100.  
  101.  
  102.  
  103. ------------------ SCREEN 6 ------------------
  104. ." LOADING EDITOR FOR VT100" CR
  105.  
  106. : CLS                        \ clear screen and home cursor
  107.   27 EMIT ." [2J" 27 EMIT ." [H"
  108. ;
  109.  
  110. : LOCATE   \ 0 16 LOCATE positions cursor at line 16, column 0
  111.   27 EMIT 91 EMIT 1+ 1 .R 59 EMIT 1+ 1 .R 72 EMIT ;
  112.  
  113. : STANDOUT                   \ This can be a null word
  114.   27 EMIT ." [7m" ;
  115.  
  116. : STANDEND                   \ This can be a null word, too.
  117.   27 EMIT ." [m" ;
  118.  
  119. ;S   \ CONTINUE LOADING EDITOR
  120. ------------------ SCREEN 7 ------------------
  121. ." LOADING EDITOR FOR ADM5" CR
  122.  
  123. : CLS 26 EMIT ;
  124.  
  125. : LOCATE
  126.   27 EMIT 61 EMIT
  127.   32 + EMIT 32 + EMIT ;
  128.  
  129.  
  130. : STANDOUT
  131.   27 EMIT 71 EMIT ;
  132.  
  133. : STANDEND
  134.   27 EMIT 71 EMIT ;
  135.  
  136. ;S   \ continue loading editor
  137. ------------------ SCREEN 8 ------------------
  138. ( Reserved for more terminals; set the name of the terminal
  139.   as a constant in screen 10 )
  140. ;S
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154. ------------------ SCREEN 9 ------------------
  155. ( Reserved for more terminals. Set the name of the terminal
  156.   as a constant in screen 10 )
  157. ;S
  158.  
  159.  
  160.  
  161.  
  162.  
  163.  
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171. ------------------ SCREEN 10 ------------------
  172. ( EDITOR -- SCREEN 1 OF 19 -- VARIABLES )
  173. DECIMAL
  174. 0 VARIABLE ROW          0 VARIABLE COL
  175. 0 VARIABLE EDIT-SCR     0 VARIABLE SCREEN-IS-MODIFIED
  176. 0 VARIABLE MUST-UPDATE  0 VARIABLE LAST-KEY-STRUCK
  177. 0 VARIABLE CURSOR-IS-DIRTY
  178.  
  179. 0 VARIABLE KEYMAP  WORDSIZE 255 *  ALLOT
  180.            KEYMAP  WORDSIZE 256 *  ERASE
  181.  
  182. 0 VARIABLE SCR-BUFFER B/BUF B/SCR * WORDSIZE - ALLOT
  183.  
  184. ( TERMINAL CONSTANTS -- VALUE IS SCREEN NUMBER TO LOAD )
  185. 6 CONSTANT VT100   7 CONSTANT ADM5
  186.  
  187. -->
  188. ------------------ SCREEN 11 ------------------
  189. ( EDITOR -- SCREEN 2 OF 19 -- SCREEN STUFF )
  190.  
  191. CR ." ENTER THE TYPE OF TERMINAL YOU ARE USING. TYPE ONE OF:"
  192. CR ."      VT100   ADM5" CR   \ list the constants from scr 10
  193.  
  194. REFORTH          \ this word gets & interprets one line.
  195. LOAD             \ load the right screen; VT100 = 6, ADM5 = 7
  196.  
  197. : EXIT-EDIT
  198.   0 16 LOCATE QUIT ;
  199. : ABORT-EDIT
  200.   0 15 LOCATE MESSAGE ;
  201.  
  202. : BIND-ADDR          ( C -- ADDR where binding is stored )
  203.   WORDSIZE * KEYMAP + ;
  204. -->
  205. ------------------ SCREEN 12 ------------------
  206. ( EDITOR -- SCREEN 3 OF 19 -- I/O )
  207.  
  208. : ^EMIT        ( OUTPUT W/ESC AND ^ )
  209.   DUP 127 > IF ." ESC-" 128 - THEN
  210.   DUP 32  < IF ." ^" 64 + THEN
  211.   EMIT ;
  212.  
  213. : BACK-WRAP     ( DECR EDIT SCR. AND PUT CURSOR AT BOTTOM )
  214.   EDIT-SCR -- C/L 1- COL ! 15     ROW ! 1 MUST-UPDATE ! ;
  215. : FORWARD-WRAP  ( INCR EDIT SCR. AND PUT CURSOR AT TOP )
  216.   EDIT-SCR ++ 0 COL ! 0 ROW ! 1 MUST-UPDATE ! ;
  217. : ED-KEY       ( INPUT W/ESC FOR HI BIT )
  218.   KEY DUP 27 = IF DROP KEY 128 + THEN
  219.   DUP LAST-KEY-STRUCK ! ;
  220.  
  221. -->
  222. ------------------ SCREEN 13 ------------------
  223. ( EDITOR -- SCREEN 4 OF 19 -- BINDING WORDS )
  224. : (BIND)         ( CFA K -- STORES INTO KEYMAP )
  225.   BIND-ADDR !
  226. ;
  227.  
  228. : BIND-TO-KEY    ( "BIND-TO-KEY NAME" ASKS FOR KEY )
  229.   [COMPILE] ' CFA
  230.   ." KEY: " ED-KEY DUP ^EMIT SPACE
  231.   (BIND) ;
  232.  
  233. : DESCRIBE-KEY
  234.   ." KEY: " ED-KEY DUP ^EMIT SPACE
  235.   BIND-ADDR @ -DUP IF NFA ID.
  236.                         ELSE ." SELF-INSERT"
  237.                         THEN SPACE ;
  238. -->
  239. ------------------ SCREEN 14 ------------------
  240. ( EDITOR -- SCREEN 5 OF 19 -- PRIMITIVE OPS )
  241.  
  242. : PREV-LINE ROW @      IF ROW -- 1 CURSOR-IS-DIRTY !
  243.                        ELSE BACK-WRAP THEN ;
  244. : NEXT-LINE ROW @ 15 < IF ROW ++ 1 CURSOR-IS-DIRTY !
  245.                        ELSE FORWARD-WRAP THEN ;
  246. : BEGINNING-OF-LINE 0 COL ! 1 CURSOR-IS-DIRTY ! ;
  247. : END-OF-LINE      C/L 1- COL ! 1 CURSOR-IS-DIRTY ! ;
  248. : EDIT-CR NEXT-LINE BEGINNING-OF-LINE ;
  249. : PREV-CHAR COL @ IF COL -- 1 CURSOR-IS-DIRTY !
  250.                   ELSE END-OF-LINE PREV-LINE
  251.                   THEN ;
  252. : NEXT-CHAR COL @ C/L 1- < IF COL ++ 1 CURSOR-IS-DIRTY !
  253.                            ELSE EDIT-CR
  254.                            THEN ;
  255. -->
  256. ------------------ SCREEN 15 ------------------
  257. ( EDITOR -- SCREEN 6 OF 19 -- MORE LOW-LEVEL )
  258. : THIS-CHAR
  259.   ROW @ EDIT-SCR @ (LINE) DROP COL @ + ;
  260.  
  261. : PUT-CHAR THIS-CHAR C! 1 MUST-UPDATE ! ;
  262.  
  263. : INSERT-CHAR PUT-CHAR NEXT-CHAR ;
  264.  
  265. : SELF-INSERT
  266.   LAST-KEY-STRUCK @ DUP THIS-CHAR C! EMIT
  267.   NEXT-CHAR
  268. ;
  269.  
  270. DECIMAL -->
  271.  
  272.  
  273. ------------------ SCREEN 16 ------------------
  274. ( EDITOR -- SCREEN  7 OF 19 -- DISPLAY STUFF )
  275. HEX
  276. : SHOWSCR         ( N -- SHOWS SCREEN N )
  277.    CLS
  278.    0 10 LOCATE STANDOUT ." SCREEN " DUP . STANDEND
  279.    10 0 DO
  280.         0 I LOCATE
  281.            I OVER .LINE
  282.         LOOP DROP ;
  283.  
  284. : REDRAW EDIT-SCR @ SHOWSCR ;
  285.  
  286. : ?REDRAW
  287.   MUST-UPDATE @ IF REDRAW 0 MUST-UPDATE !
  288.                           1 CURSOR-IS-DIRTY ! THEN ;
  289. DECIMAL -->
  290. ------------------ SCREEN 17 ------------------
  291. ( EDITOR -- SCREEN  8 OF 19 -- EXECUTE-KEY )
  292.  
  293. : EXECUTE-KEY        ( K -- EXECUTE THE KEY )
  294.   WORDSIZE * KEYMAP + @ -DUP IF
  295.                            EXECUTE
  296.                         ELSE
  297.                            SELF-INSERT
  298.                         THEN
  299. ;
  300. : ?PLACE-CURSOR
  301.   CURSOR-IS-DIRTY @ IF
  302.     COL @ ROW @ LOCATE
  303.     0 CURSOR-IS-DIRTY !
  304.   THEN
  305. ;
  306. -->
  307. ------------------ SCREEN 18 ------------------
  308. ( EDITOR -- SCREEN  9 OF 19 -- TOP-LEVEL )
  309. : TOP-LEVEL
  310.   BEGIN
  311.     ?REDRAW ?PLACE-CURSOR ED-KEY EXECUTE-KEY
  312.   AGAIN
  313. ;
  314.  
  315.  
  316. : EDIT
  317.   EDIT-SCR ! CLS
  318.   0 ROW ! 0 COL ! 1 MUST-UPDATE !
  319.   TOP-LEVEL
  320. ;
  321.  
  322.  
  323. -->
  324. ------------------ SCREEN 19 ------------------
  325. ( EDITOR -- SCREEN 10 OF 19 -- HIGH-LEVEL KEY WORDS )
  326.  
  327. : UPDATE-SCR                 ( BOUND TO ^U )
  328.   EDIT-SCR @ B/SCR * DUP B/SCR + SWAP DO
  329.     I BLOCK DROP UPDATE
  330.   LOOP ;
  331.  
  332.  
  333. : NEXT-SCR                   ( ^C and ESC-C )
  334.   EDIT-SCR ++   1 MUST-UPDATE !
  335. ;
  336.  
  337. : PREV-SCR                   ( ^R and ESC-R )
  338.   EDIT-SCR @ 0= IF EDIT-SCR ++ THEN
  339.   EDIT-SCR --   1 MUST-UPDATE ! ;
  340. -->
  341. ------------------ SCREEN 20 ------------------
  342. ( EDITOR -- SCREEN 11 OF 19 -- HIGH-LEVEL )
  343. HEX
  344. : TAB-KEY        ( INCREMENT TO NEXT TAB STOP )
  345.   COL @ 8 + F8 AND DUP C/L < IF COL ! THEN ;
  346.  
  347. DECIMAL
  348.  
  349. : REEDIT         ( RESTART EDITING )
  350.   EDIT-SCR @ EDIT ;
  351.  
  352. : ERRCONV
  353.   ERRBLK @ DUP B/SCR / SWAP B/SCR MOD DUP +
  354.   ERRIN @ C/L @ / + ;
  355. : ERREDIT ERRCONV RO